home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Camelot / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].zip / Camelot 098 (1990-12)(Swedish User Group of Amiga)(SE)(PD)[WB].adf / XLisp-Stat / Examples / regdemo.lsp < prev    next >
Lisp/Scheme  |  1990-10-11  |  3KB  |  114 lines
  1. (require "graphics")
  2.  
  3. ;;;;
  4. ;;;;
  5. ;;;;
  6. ;;;; Regression Demo
  7. ;;;;
  8. ;;;; Examines the effect of deleting and moving points on a simple linear 
  9. ;;;; regression. This version does not 
  10. ;;;;
  11. ;;;;
  12.  
  13. ;;; REGRESSION-DEMO-PROTO - instance variables are
  14. ;;;      x, y - regression variables
  15. ;;;      a, b - regression intercept and slope
  16. ;;;
  17. (defproto regression-demo-proto '() () scatterplot-proto)
  18. (send regression-demo-proto :add-mouse-mode 'point-moving
  19.       :title "Point Moving"
  20.       :cursor 'finger
  21.       :click :do-point-moving)
  22.  
  23. ;;;;
  24. ;;;; Overrides for standard plot messages
  25. ;;;;
  26.  
  27. ;;;
  28. ;;; :ISNEW method - only allows two dimensional plot and installs 
  29. ;;; data in the plot.
  30. ;;;
  31. (defmeth regression-demo-proto :isnew (x y)
  32.   (call-next-method 2)
  33.   (send self :new-menu)
  34.   (send self :mouse-mode 'point-moving)
  35.   (send self :add-points x y)
  36.   (send self :show-all-points)) ; line added JKL
  37.  
  38. ;;;
  39. ;;; :DO-POINT-MOVING method - if there is a point close to
  40. ;;; the mouse drag it and recalculate the regression line.
  41. ;;;
  42. (defmeth regression-demo-proto :do-point-moving (x y a b)
  43.   (let ((p (send self :drag-point x y :draw nil)))
  44.     (if p (send self :set-regression-line))))
  45.  
  46. ;;;
  47. ;;; :ADD-POINTS method - add points to the plot, append them to the 
  48. ;;; instance variables x and y, and recalculate the regression
  49. ;;;
  50. (defmeth regression-demo-proto :add-points (x y)
  51.   (call-next-method x y :draw nil)
  52.   (send self :adjust-to-data :draw nil)
  53.   (send self :set-regression-line))
  54.  
  55. ;;;
  56. ;;; :SHOW-ALL-POINTS - show all points in the plot and recalculate the
  57. ;;; regression
  58. ;;;
  59. (defmeth regression-demo-proto :show-all-points () 
  60.   (call-next-method)
  61.   (send self :set-regression-line))
  62.  
  63. ;;;
  64. ;;; :ERASE-SELECTION - erase selection from the plot and recalculate the
  65. ;;; regression
  66. ;;;
  67. (defmeth regression-demo-proto :erase-selection () 
  68.   (call-next-method)
  69.   (send self :set-regression-line))
  70.  
  71. ;;;;
  72. ;;;; REGRESSION-DEMO-PROTO Specific Methods
  73. ;;;;
  74.  
  75. ;;;
  76. ;;; :SET-REGRESSION-LINE installs the regression line in the plot
  77. ;;;
  78. (defmeth regression-demo-proto :set-regression-line ()
  79.   (let ((coefs (send self :calculate-coefficients)))
  80.     (send self :clear-lines :draw (null coefs))
  81.     (if coefs (apply #'send self :abline coefs))))
  82.  
  83. ;;;
  84. ;;; :CALCULATE-COEFFICIENTS calculates the new coefficients and returns them
  85. ;;; as a list. If there ar not at least two points with different x values
  86. ;;; NIL is returned
  87. ;;;
  88. (defmeth regression-demo-proto :calculate-coefficients ()
  89.   (let ((i (which (send self :point-showing
  90.                         (iseq 0 (- (send self :num-points) 1))))))
  91.     (if (<= (length i) 1) 
  92.         nil
  93.         (let* ((x (send self :point-coordinate 0 i))
  94.                (y (send self :point-coordinate 1 i))
  95.                (x-bar (mean x))
  96.                (y-bar (mean y))
  97.                (x1 (- x x-bar))
  98.                (y1 (- y y-bar))
  99.                (sxx (sum (* x1 x1)))
  100.                (sxy (sum (* x1 y1)))
  101.                a
  102.                b)
  103.           (when (> sxx 0) 
  104.                 (setq b (/ sxy sxx))
  105.                 (setq a (- y-bar (* b x-bar)))
  106.                 (list a b))))))
  107.  
  108. ;;;;
  109. ;;;; Regression Demo Function
  110. ;;;;
  111. (defun regression-demo (x y)
  112.   (let ((w (send regression-demo-proto :new x y)))
  113.     w))
  114.